home *** CD-ROM | disk | FTP | other *** search
/ Especial Multimedia / Especial Multimedia.iso / Multimed / Prg / THRMDEMO.ZIP / THERM.BAS < prev    next >
BASIC Source File  |  1997-09-14  |  6KB  |  156 lines
  1. Option Explicit
  2. '*******************************************************
  3. '* Integrated Data Systems, Inc.                       *
  4. '* 23875 Ventura Blvd. #102                            *
  5. '* Calabasas, Ca  91302                                *
  6. '* Voice: (818)223-3344                                *
  7. '* BBS:   (818)223-3341                                *
  8. '* CIS:   73700,1622                                   *
  9. '*******************************************************
  10. '*                                                     *
  11. '*      File Name: Therm.BAS                           *
  12. '*                 Uses Therm.FRM                      *
  13. '*                                                     *
  14. '*        Created: 12/23/94     By: Robert Vandehey    *
  15. '*                                                     *
  16. '* Comments: Displays a progress thermometer.          *
  17. '*                                                     *
  18. '* InitPercent(MaxValue, Message) - Initializes control*
  19. '*                                  for percent display*
  20. '* InitValue(Message) - Initializes control for value  *
  21. '*                      display                        *
  22. '* Tick() - Moves thermometer by one tick              *
  23. '* UpdatePercent(Percent) - Moves thermometer to this  *
  24. '*                          percent.                   *
  25. '* UpdateValue(Value) - Moves thermometer to this      *                        *
  26. '*                      value.                         *
  27. '*                                                     *
  28. '*******************************************************
  29.  
  30. ' Variable Declarations
  31. Dim b_byPercent As Integer
  32. Dim l_MaxValue As Long
  33. Dim l_CurrValue As Long
  34.  
  35. Sub CenterForm (ctrl_item As Form)
  36.     ctrl_item.Left = (screen.Width - ctrl_item.Width) / 2
  37.     ctrl_item.Top = (screen.Height - ctrl_item.Height) / 2
  38. End Sub
  39.  
  40. Function Max (ByVal l1 As Long, ByVal l2 As Long) As Long
  41.     Max = IIf(l1 > l2, l1, l2)
  42. End Function
  43.  
  44. Function Min (ByVal l1 As Long, ByVal l2 As Long) As Long
  45.     Min = IIf(l1 < l2, l1, l2)
  46. End Function
  47.  
  48. Private Sub ShowValue ()
  49.     If b_byPercent Then
  50.         Thermometer!Gauge.FloodPercent = Min(100, Int(l_CurrValue / l_MaxValue * 100 + .5))
  51.     Else
  52.         Thermometer!Gauge.Caption = Str$(l_CurrValue)
  53.     End If
  54. End Sub
  55.  
  56. Sub ThermClose ()
  57.     Unload Thermometer
  58. End Sub
  59.  
  60. '*******************************************************
  61. '*                                                     *
  62. '* Procedure Name: InitPercent                         *
  63. '*                                                     *
  64. '*        Created: 12/22/94     By: RDV                *
  65. '*                                                     *
  66. '* Comments: Initializes control for percent display.  *
  67. '*                                                     *
  68. '*******************************************************
  69. Sub ThermInitPercent (ByVal l_MaxTicks As Long, ByVal s_Message As String)
  70.     Load Thermometer
  71.     b_byPercent = True
  72.     l_MaxValue = l_MaxTicks
  73.     l_CurrValue = 0
  74.     Thermometer!Gauge.FloodType = 1
  75.     Thermometer!Gauge.FloodShowPct = True
  76.     If Len(s_Message) > 0 Then
  77.         Thermometer!txt_message = s_Message
  78.     End If
  79.     Call CenterForm(Thermometer)
  80.     Thermometer.Show
  81.     If l_MaxValue > 0 Then
  82.         ShowValue
  83.     End If
  84.     Thermometer.Refresh
  85. End Sub
  86.  
  87. '*******************************************************
  88. '*                                                     *
  89. '* Procedure Name: InitValue                           *
  90. '*                                                     *
  91. '*        Created: 12/22/94     By: RDV                *
  92. '*                                                     *
  93. '* Comments: Initializes control for value display.    *
  94. '*                                                     *
  95. '*******************************************************
  96. Sub ThermInitValue (ByVal s_Message As String)
  97.     Load Thermometer
  98.     b_byPercent = False
  99.     l_MaxValue = 0
  100.     l_CurrValue = 0
  101.     Thermometer!Gauge.FloodShowPct = False
  102.     Thermometer!Gauge.FloodType = 0
  103.     If Len(s_Message) > 0 Then
  104.         Thermometer!txt_message = s_Message
  105.     End If
  106.     Call CenterForm(Thermometer)
  107.     Thermometer.Show
  108.     ShowValue
  109.     Thermometer.Refresh
  110. End Sub
  111.  
  112. '*******************************************************
  113. '*                                                     *
  114. '* Procedure Name: Tick                                *
  115. '*                                                     *
  116. '*        Created: 12/22/94     By: RDV                *
  117. '*                                                     *
  118. '* Comments: Moves thermometer by one tick             *
  119. '*                                                     *
  120. '*******************************************************
  121. Sub ThermTick ()
  122.     l_CurrValue = l_CurrValue + 1
  123.     ShowValue
  124. End Sub
  125.  
  126. '*******************************************************
  127. '*                                                     *
  128. '* Procedure Name: UpdatePercent                       *
  129. '*                                                     *
  130. '*        Created: 12/22/94     By: RDV                *
  131. '*                                                     *
  132. '* Comments: Moves thermometer to this percent         *
  133. '*                                                     *
  134. '*******************************************************
  135. Sub ThermUpdatePercent (ByVal i_percent As Integer)
  136.     l_CurrValue = Int(l_MaxValue * i_percent / 100)
  137.     ShowValue
  138. End Sub
  139.  
  140. '*******************************************************
  141. '*                                                     *
  142. '* Procedure Name: UpdateValue                         *
  143. '*                                                     *
  144. '*        Created: 12/22/94     By: RDV                *
  145. '*                                                     *
  146. '* Comments: Moves thermometer to this value.          *
  147. '*           This is used when the total to process    *
  148. '*           isn't known.                              *
  149. '*                                                     *
  150. '*******************************************************
  151. Sub ThermUpdateValue (ByVal l_value As Long)
  152.     l_CurrValue = l_value
  153.     ShowValue
  154. End Sub
  155.  
  156.